home *** CD-ROM | disk | FTP | other *** search
/ PC Answers 1995 May / PC Answers CD-ROM 7 (Future Publishing) (May 1995).iso / vbits / code / morris / abtmain.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1994-11-15  |  9.9 KB  |  254 lines
  1. VERSION 2.00
  2. Begin Form frmMainForm 
  3.    BackColor       =   &H8000000F&
  4.    BorderStyle     =   1  'Fixed Single
  5.    Caption         =   "TMS 'About' Demo"
  6.    ClientHeight    =   1572
  7.    ClientLeft      =   4008
  8.    ClientTop       =   3216
  9.    ClientWidth     =   3972
  10.    Height          =   2316
  11.    Icon            =   ABTMAIN.FRX:0000
  12.    Left            =   3960
  13.    LinkTopic       =   "Form1"
  14.    MaxButton       =   0   'False
  15.    ScaleHeight     =   1572
  16.    ScaleWidth      =   3972
  17.    Top             =   2520
  18.    Width           =   4068
  19.    Begin Label labDesignNote 
  20.       Alignment       =   2  'Center
  21.       AutoSize        =   -1  'True
  22.       BackColor       =   &H00FF0000&
  23.       BorderStyle     =   1  'Fixed Single
  24.       Caption         =   "This form is the 'launch' form for two (or is that three!) 'About' boxes each of which uses some techniques/APIs to do some neat stuff."
  25.       FontBold        =   0   'False
  26.       FontItalic      =   0   'False
  27.       FontName        =   "MS Sans Serif"
  28.       FontSize        =   7.8
  29.       FontStrikethru  =   0   'False
  30.       FontUnderline   =   0   'False
  31.       ForeColor       =   &H0000FFFF&
  32.       Height          =   852
  33.       Left            =   120
  34.       TabIndex        =   1
  35.       Top             =   600
  36.       Visible         =   0   'False
  37.       Width           =   3732
  38.       WordWrap        =   -1  'True
  39.    End
  40.    Begin Label lblDummy 
  41.       Alignment       =   2  'Center
  42.       AutoSize        =   -1  'True
  43.       BackStyle       =   0  'Transparent
  44.       BorderStyle     =   1  'Fixed Single
  45.       Caption         =   "Select 'Help', 'About...' For Demo and 'Help', 'Contents' for Explanation."
  46.       FontBold        =   0   'False
  47.       FontItalic      =   0   'False
  48.       FontName        =   "MS Sans Serif"
  49.       FontSize        =   7.8
  50.       FontStrikethru  =   0   'False
  51.       FontUnderline   =   0   'False
  52.       Height          =   408
  53.       Left            =   120
  54.       TabIndex        =   0
  55.       Top             =   108
  56.       Width           =   3732
  57.       WordWrap        =   -1  'True
  58.    End
  59.    Begin Menu mnuHelp 
  60.       Caption         =   "&Help"
  61.       Begin Menu mnuHelpContents 
  62.          Caption         =   "&Contents"
  63.       End
  64.       Begin Menu mnuHelpSep1 
  65.          Caption         =   "-"
  66.       End
  67.       Begin Menu mnuHelpAbout 
  68.          Caption         =   "&About TMS About Application..."
  69.       End
  70.       Begin Menu mnuHelpRealAbout 
  71.          Caption         =   "&Real 'About'..."
  72.       End
  73.    End
  74. '*******************************************************************************
  75. ' The Mandelbrot Set (International) Ltd. may be reached by the following means:
  76. ' CIS: 100016,2751
  77. ' Internet 100016.2751@Compuserve.com
  78. ' FAX: (+44) 01451 860142.
  79. ' Telephone: (+44) 0941 117534.
  80. ' TMS accepts no liability whatsoever for this code or demonstration.
  81. '*******************************************************************************
  82. '==========================================================
  83. '    Module - ABTMAIN.FRM
  84. '    Module Prefix - None
  85. '    Author - Peter J. Morris. TMS Ltd.
  86. '    Date Written : #### Date - 16/11/94    Time - 03:11
  87. '    Purpose - Example of how to use API for VBITS talk.
  88. '    Revisions
  89. '    BY            WHY            AFFECTED
  90. '    Peter J. Morris. TMS Ltd. Original code.
  91. '==========================================================
  92. Option Explicit
  93. '==========================================================
  94. '    Function - Form_Load
  95. '    Author - Peter J. Morris. TMS Ltd.
  96. '    Date Written: #### Date - 16/11/94    Time - 03:11
  97. '    Purpose - See function purpose.
  98. '    Revisions:
  99. '    BY            WHY            AFFECTED
  100. '    Peter J. Morris. TMS Ltd. Original code.
  101. '    INPUTS -  None
  102. '    OUTPUTS - None
  103. '==========================================================
  104. Private Sub Form_Load ()
  105. '==========================================================
  106. '    Form: ABTMAIN.FRM Procedure: Form_Load
  107. '    Author - Peter J. Morris. TMS Ltd.
  108. '    Template fitted: #### Date - 16/11/94    Time - 03:11
  109. '    Copyright and status if any: Copyright 
  110.  TMS 1994,1995
  111. '    All rights reserved. Status @BLUE@TMS.DEMO@COLD
  112. '    Purpose/Description In brief:
  113. '    Simple form initialisation.
  114. '=========================================================
  115. ' Set up general error handler
  116. On Error GoTo Error_Form_Load:
  117.     ' ========== Code Starts.==========
  118.     Const sHelpFile = "HELP.HLP"
  119.     ' Set some globals up.
  120.     Init
  121.     ' Center window in middle of screen.
  122.     CenterWindow Me
  123.     ' Make sure text fits in labels.
  124.     DoLabels Me
  125.     ' Set up help file path etc.
  126.     If Right$(App.Path, 1) <> "\" Then
  127.         App.HelpFile = App.Path & "\" & sHelpFile
  128.     Else
  129.         App.HelpFile = App.Path & sHelpFile
  130.     End If
  131.     ' ========== Code Ends  .==========
  132.     Exit Sub
  133. ' Error handler
  134. Error_Form_Load:
  135.     ' Call general error handler
  136.     ErrorHandler "ABTMAIN.FRM/Form_Load", Err, Error$
  137.     ' Default resume behaviour: exit this sub/func
  138.     Resume Exit_Form_Load:
  139. Exit_Form_Load:
  140. End Sub
  141. '==========================================================
  142. '    Function - mnuHelpAbout_Click
  143. '    Author - Peter J. Morris. TMS Ltd.
  144. '    Date Written: #### Date - 16/11/94    Time - 03:11
  145. '    Purpose - See function purpose.
  146. '    Revisions:
  147. '    BY            WHY            AFFECTED
  148. '    Peter J. Morris. TMS Ltd. Original code.
  149. '    INPUTS -  None
  150. '    OUTPUTS - None
  151. '==========================================================
  152. Private Sub mnuHelpAbout_Click ()
  153. '==========================================================
  154. '    Form: ABTMAIN.FRM Procedure: mnuHelpAbout_Click
  155. '    Author - Peter J. Morris. TMS Ltd.
  156. '    Template fitted: #### Date - 16/11/94    Time - 03:11
  157. '    Copyright and status if any: Copyright 
  158.  TMS 1994,1995
  159. '    All rights reserved. Status @BLUE@TMS.DEMO@COLD
  160. '    Purpose/Description In brief:
  161. '    Show 'first' about box in MS Word Style.
  162. '=========================================================
  163. ' Set up general error handler
  164. On Error GoTo Error_mnuHelpAbout_Click:
  165.     ' ========== Code Starts.==========
  166.     frmAboutBox.Show MODAL
  167.     ' ========== Code Ends  .==========
  168.     Exit Sub
  169. ' Error handler
  170. Error_mnuHelpAbout_Click:
  171.     ' Call general error handler
  172.     ErrorHandler "ABTMAIN.FRM/mnuHelpAbout_Click", Err, Error$
  173.     ' Default resume behaviour: exit this sub/func
  174.     Resume Exit_mnuHelpAbout_Click:
  175. Exit_mnuHelpAbout_Click:
  176. End Sub
  177. '==========================================================
  178. '    Function - mnuHelpContents_Click
  179. '    Author - Peter J. Morris. TMS Ltd.
  180. '    Date Written: #### Date - 16/11/94    Time - 03:11
  181. '    Purpose - See function purpose.
  182. '    Revisions:
  183. '    BY            WHY            AFFECTED
  184. '    Peter J. Morris. TMS Ltd. Original code.
  185. '    INPUTS -  None
  186. '    OUTPUTS - None
  187. '==========================================================
  188. Private Sub mnuHelpContents_Click ()
  189. '==========================================================
  190. '    Form: ABTMAIN.FRM Procedure: mnuHelpContents_Click
  191. '    Author - Peter J. Morris. TMS Ltd.
  192. '    Template fitted: #### Date - 16/11/94    Time - 03:11
  193. '    Copyright and status if any: Copyright 
  194.  TMS 1994,1995
  195. '    All rights reserved. Status @BLUE@TMS.DEMO@COLD
  196. '    Purpose/Description In brief:
  197. '    Shows help file.
  198. '=========================================================
  199. ' Set up general error handler
  200. On Error GoTo Error_mnuHelpContents_Click:
  201.     ' ========== Code Starts.==========
  202.     ' Show help file.
  203.     Const HELP_CONTENTS = &H3
  204.     ' Start help file.
  205.     If WinHelp(Me.hWnd, App.HelpFile, HELP_CONTENTS, 0) = 0 Then
  206.         MsgBox "WinHelp cannot start the help file for some reason!", MB_OK, "Error"
  207.     End If
  208.     ' ========== Code Ends  .==========
  209.     Exit Sub
  210. ' Error handler
  211. Error_mnuHelpContents_Click:
  212.     ' Call general error handler
  213.     ErrorHandler "ABTMAIN.FRM/mnuHelpContents_Click", Err, Error$
  214.     ' Default resume behaviour: exit this sub/func
  215.     Resume Exit_mnuHelpContents_Click:
  216. Exit_mnuHelpContents_Click:
  217. End Sub
  218. '==========================================================
  219. '    Function - mnuHelpRealAbout_Click
  220. '    Author - Peter J. Morris. TMS Ltd.
  221. '    Date Written: #### Date - 16/11/94    Time - 03:11
  222. '    Purpose - See function purpose.
  223. '    Revisions:
  224. '    BY            WHY            AFFECTED
  225. '    Peter J. Morris. TMS Ltd. Original code.
  226. '    INPUTS - None
  227. '    OUTPUTS - None
  228. '==========================================================
  229. Private Sub mnuHelpRealAbout_Click ()
  230. '==========================================================
  231. '    Form: ABTMAIN.FRM Procedure: mnuHelpRealAbout_Click
  232. '    Author - Peter J. Morris. TMS Ltd.
  233. '    Template fitted: #### Date - 16/11/94    Time - 03:11
  234. '    Copyright and status if any: Copyright 
  235.  TMS 1994,1995
  236. '    All rights reserved. Status @BLUE@TMS.DEMO@COLD
  237. '    Purpose/Description In brief:
  238. '    Puts up 'real "About" box.
  239. '=========================================================
  240. ' Set up general error handler
  241. On Error GoTo Error_mnuHelpRealAbout_Click:
  242.     ' ========== Code Starts.==========
  243.     MsgBox "'About' was written by The Mandelbrot Set (Int'l) Ltd. for VBITS as a demonstration of how to access the Windows' API.", MB_OK Or MB_ICONINFORMATION, "About..."
  244.     ' ========== Code Ends  .==========
  245.     Exit Sub
  246. ' Error handler
  247. Error_mnuHelpRealAbout_Click:
  248.     ' Call general error handler
  249.     ErrorHandler "ABTMAIN.FRM/mnuHelpRealAbout_Click", Err, Error$
  250.     ' Default resume behaviour: exit this sub/func
  251.     Resume Exit_mnuHelpRealAbout_Click:
  252. Exit_mnuHelpRealAbout_Click:
  253. End Sub
  254.